home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / DDPLUS71.ZIP / LOCKING.ZIP / LDEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-21  |  11.9 KB  |  436 lines
  1. (**************************************)
  2. (*   Programming:  Bob Dalton         *)
  3. (*   DEMO OF DOOR FILE SETUP ROUTINE  *)
  4. (**************************************)
  5.  
  6. PROGRAM LDEMO;    (* Initialization Program -- resets player file *)
  7. {$R-}
  8. {$S+}
  9. {$I+}
  10. {$N-}
  11. {$M 65520,16384,655360}
  12.  
  13. Uses
  14.  Crt,
  15.  DOS,
  16.  DDPlus,
  17.  Elog,
  18.  NETFILEP;
  19.  
  20. Const
  21.   Version1 = '0.00';
  22.   Author = 'Bob Dalton';
  23. Type
  24.   PlayerRecord = Record
  25.                    PRecordNumber:Byte;
  26.                    Item1: String[15]; {Player name}
  27.                    Item2: LongInt;    {Player money}
  28.                    Item3: Integer;    {Player soldiers}
  29.                    Item4: Byte;       {Player cannons}
  30.                    Item5: String[1];  {Is he King}
  31.                  End;
  32.  
  33.   GlobRec = Record
  34.              MaxPlayers:Byte;
  35.              MaxMoney  :LongInt;
  36.             End;
  37.  
  38.   PlayerList = File of PlayerRecord;
  39.   GlobFile1 = File of GlobRec;
  40.  
  41. VAR
  42.   Qty: String[7];
  43.   Palias:String[15];
  44.   GoAhead: Boolean;
  45.   OpenAttempts:Byte;
  46.   CurRecord : longint;
  47.   PlayerFile: PlayerList;
  48.   Player: PlayerRecord;
  49.   Year,Month,Day,Dow: Word;
  50.   Glob:GlobRec;
  51.   GlobFile:GlobFile1;
  52.   Y99: Byte;
  53.   Good:Boolean;
  54.   Code:Integer;
  55.   Vmoney:Integer;
  56.  
  57. Function GetInput(s:string;Cap,Len:Integer):string;
  58.  Var Ps:string;
  59.  Begin
  60.   Prompt(Ps,Len,false);
  61.   GetInput:=Ps
  62.  End;
  63.  
  64.  
  65. FUNCTiON GetChar:Char;
  66.  Var C:Char;
  67.  Begin
  68.   Sread_Char(C);
  69.   GetChar:=C
  70.  End;
  71.  
  72. PROCEDURE Nsp(I:LongInt);
  73. VAR Convnum:String[25];
  74.  BEGIN
  75.   Str(I,Convnum);
  76.   Swrite(Convnum)
  77.  End;
  78.  
  79. PROCEDURE TC( Cor: Byte);
  80.   Begin
  81.    Set_Foreground(Cor)
  82.   End;
  83.  
  84. PROCEDURE CP(X,Y: Integer);
  85.  Begin
  86.   Sgoto_XY(x,y)
  87.  End;
  88.  
  89. PROCEDURE Pause1;
  90. VAR C:char;
  91.  Begin
  92.   CP(1,23);
  93.   TC(6);
  94.   Swrite('Press any key to continue');
  95.   Sread_Char(C);
  96.  End;
  97.  
  98. Procedure ReadGlobalFile(VAR Glob:GlobRec); {Example of File Locking}
  99.  Begin
  100.   Assign(GlobFile,'GLOB.DAT');
  101.   OpenAttempts:=1;
  102.   Repeat
  103.    {$I-}
  104.    Reset(GlobFile); {opens the file}
  105.    {$I+};
  106.    GoAhead:= (IOResult = 0);
  107.    If Not GoAhead then OpenAttempts :=OpenAttempts+1;
  108.   Until (GoAhead) or (OpenAttempts>1000);
  109.   Read(GlobFile,Glob);{reads the entire file}
  110.   Close(GlobFile);{closes the file}
  111.   SClrScr;
  112.   SWriteLn('');
  113.   SWriteLn('');
  114.   SWriteLn('');
  115.   SWrite('Max Players Allowed: ');NSP(Glob.MaxPlayers);
  116.   SWriteln('');
  117.   SWrite('Max Money Allowed  : ');NSP(Glob.MaxMoney);
  118.   SWriteln('');
  119.   Pause1;
  120.   SClrScr;
  121.  End;
  122.  
  123. Procedure WriteGlobalFile(VAR Glob:GlobRec); {Example of File Locking}
  124.  Begin
  125.   SClrScr;
  126.   SWriteLn('');
  127.   SWriteLn('');
  128.   SWriteLn('');
  129.   SWrite('Max Players Allowed: ');NSP(Glob.MaxPlayers);
  130.   SWriteln('');
  131.   Repeat
  132.    SWriteLn('');
  133.    SWrite('New maximum amount of players <Max of 100>: ');
  134.    QTY:=GetInput('',0,15);
  135.    VAL (Qty,Vmoney,code);
  136.   UNTIL (Vmoney > 1) OR (Code <> 0);
  137.   Glob.MaxPlayers:=Vmoney;
  138.   SwriteLn('');
  139.   SWrite('Max Money Allowed  : ');NSP(Glob.MaxMoney);
  140.   SWriteln('');
  141.   Repeat
  142.    SWriteLn('');
  143.    SWrite('New maximum amount of player money <Max of $5000>: ');
  144.    QTY:=GetInput('',0,15);
  145.    VAL (Qty,Vmoney,code);
  146.   UNTIL (Vmoney > 1) OR (Code <> 0);
  147.   Glob.MaxMoney:=Vmoney;
  148.   SwriteLn('');
  149.   SClrScr;
  150.   IF ShareInst then FileMode:=64; {Prevents changes to file until YOU are done with it}
  151.   Assign(GlobFile,'GLOB.DAT');
  152.   OpenAttempts:=1;
  153.   Repeat
  154.    {$I-}
  155.    Rewrite(GlobFile);{Writes a zero byte file}
  156.    {$I+};
  157.    GoAhead:= (IOResult = 0);
  158.    If Not GoAhead then OpenAttempts :=OpenAttempts+1;
  159.   Until (GoAhead) or (OpenAttempts>1000);
  160.   Write(GlobFile,Glob);  {writes the information to the data file}
  161.   Close(GlobFile);{closes the file}
  162.   IF ShareInst then FileMode:=66; {Allows changes to file}
  163.  End;
  164.  
  165. {The procedure below searches an entire data file of records until
  166.  it finds a matching record.  Once we find that record we automatically
  167.  know what the record number is because there is a variable in the record
  168.  which tells us.}
  169.  
  170. PROCEDURE GetPlayerName( Palias: String;
  171.                          VAR Gplay: PlayerRecord;
  172.                          VAR Good: Boolean);
  173. VAR Pfile: PlayerList;Temp: PlayerRecord;
  174.  Begin
  175.   Assign(Pfile,'PLAYER.DAT');
  176.   OpenAttempts:=1;
  177.   Repeat
  178.    {$I-}
  179.    Reset(Pfile); {Opens the file}
  180.    {$I+};
  181.    GoAhead:= (IOResult = 0);{Traps errors so program does not abort}
  182.    If Not GoAhead then OpenAttempts :=OpenAttempts+1;  {Increments counter}
  183.   Until (GoAhead) or (OpenAttempts>1000);{Loop just in case}
  184.   Good:=False;
  185.   If NOT EOF(Pfile) THEN {If not enod file continue checking}
  186.    REPEAT
  187.     Read(Pfile,Temp); {reads a record from the file and assigns it to TEMP}
  188.     If Palias = Temp.Item1 THEN Good:=True  {If name matches then we got it!}
  189.    UNTIL (GOOD) OR EOF(Pfile); {Until we find it or we reach the end of the file}
  190.   Close(Pfile);{Gotta close it!}
  191.   IF Good THEN Gplay:=Temp {assigns the temp record we found to GPLAY}
  192.  End;
  193.  
  194. Procedure ReadAPlayerRecord(VAR Player: PlayerRecord); {Example of Record Locking}
  195. VAR Palias:String[15];
  196.  Begin
  197.   SClrScr;
  198.   SWriteLn('');
  199.   SWriteLn('');
  200.   Good:=False;
  201.   Repeat
  202.    Repeat
  203.     SWriteLn('');
  204.     SWriteLn('');
  205.     SClrScr;
  206.     SwriteLn('NOTE: Data you type is case sensitive!');
  207.     SWrite('Who would you like to Display <try Hamlet first!>: ');
  208.     Palias:=GetInput('',0,15);
  209.    UNTIL PAlias <> '';
  210.    GetPlayerName(Palias,Player,Good); {Procedure to search database file}
  211.    If Good=False then
  212.     Begin
  213.      SwriteLn('No such player by that name - try again,');
  214.     End;
  215.   Until Good=True;
  216.   Assign(PlayerFile,'PLAYER.DAT');
  217.   OpenAttempts:=1;
  218.   Repeat
  219.    {$I-}
  220.    Reset(PlayerFile); {Must do before reading/writing records!}
  221.    {$I+}
  222.    GoAhead:= (IOResult = 0); {Traps I/O errors so program does not abort}
  223.    If Not GoAhead then OpenAttempts :=OpenAttempts+1;{increments loop counter}
  224.   Until (GoAhead) or (OpenAttempts>1000); {A loop in case someone else is using it}
  225.   CurRecord := Player.PRecordNumber;{Very important!!!}
  226.   NetSeek( PlayerFile, CurRecord ); {Moves pointer to that record}
  227.   NetLock( PlayerFile, CurRecord, 1 ); {Locks that record}
  228.   NetRead( PlayerFile, Player); {Reads that record}
  229.   NetUnlock( PlayerFile, CurRecord, 1 ); {Unlocks that record}
  230.   Close(PlayerFile);{Closes the file}
  231.   SClrScr;
  232.   SWriteLn('');
  233.   SWriteLn('');
  234.   Swrite('PlayerRecord Number: ');NSP(Player.PRecordNumber);
  235.   SWriteLn('');
  236.   Swrite('Player Name: '+Player.Item1);
  237.   SWriteLn('');
  238.   Swrite('Player Money: $');;NSP(Player.Item2);
  239.   SwriteLn('');
  240.   SWrite('Player Soldiers: ');NSP(Player.Item3);
  241.   SWriteLn('');
  242.   SWrite('Player Cannons: ');NSP(Player.Item4);
  243.   SWriteLn('');
  244.   Swrite('Is he king <Y or N>: '+Player.Item5);
  245.   Pause1;
  246.  End;
  247.  
  248. FUNCTION YORN : CHAR;
  249.   Var Choice:Char;
  250. Begin
  251.   Repeat
  252.    Choice:=UPCASE(GetChar)
  253.   UNTIL Choice IN ['Y','N'];
  254.   YORN:=Choice
  255. End;
  256.  
  257. Procedure WriteToAPlayerRecord (VAR Player: PlayerRecord);{Example of Record Locking}
  258. VAR A1:String[1];
  259.  Begin
  260.   SClrScr;
  261.   SWriteLn('');
  262.   SWriteLn('');
  263.   Good:=False;
  264.   Repeat
  265.    Repeat
  266.     SWriteLn('');
  267.     SWriteLn('');
  268.     SClrScr;
  269.     SwriteLn('NOTE: Data you type is case sensitive!');
  270.     Swriteln('');
  271.     SWrite('Who would you like to change <try Hamlet first!>: ');
  272.     Palias:=GetInput('',0,15);
  273.    UNTIL PAlias <> '';
  274.    GetPlayerName(Palias,Player,Good); {Procedure to search database file}
  275.    If Good=False then
  276.     Begin
  277.      SwriteLn('No such player by that name - try again,');
  278.     End;
  279.   Until Good=True;
  280.   SClrScr;
  281.   SWriteLn('');
  282.   Swrite('Player Name: '+Player.Item1);
  283.   Repeat
  284.    SWriteLn('');
  285.    SWrite('New name for player <Max of 15 characters>: ');
  286.    Player.Item1:=GetInput('',0,15);
  287.   UNTIL PAlias <> '';
  288.   SWriteLn('');
  289.   Swrite('Player Money: $');NSP(Player.Item2);
  290.   Repeat
  291.    SWriteLn('');
  292.    SWrite('New amount of money <Max of $5000>: ');
  293.    QTY:=GetInput('',0,15);
  294.    VAL (Qty,Vmoney,code);
  295.   UNTIL (Vmoney > 1) OR (Code <> 0);
  296.   Player.Item2:=Vmoney;
  297.   SwriteLn('');
  298.   SWrite('Player Soldiers: ');NSP(Player.Item3);
  299.   SWriteLn('');
  300.   Repeat
  301.    SWriteLn('');
  302.    SWrite('New amount of soldiers <Max of 1000>: ');
  303.    QTY:=GetInput('',0,15);
  304.    VAL (Qty,Vmoney,code);
  305.   UNTIL (Vmoney > 1) OR (Code <> 0);
  306.   Player.Item3:=Vmoney;
  307.   SWrite('Player Cannons: ');NSP(Player.Item4);
  308.   SWriteLn('');
  309.   Repeat
  310.    SWriteLn('');
  311.    SWrite('New amount of cannons <Max of 100>: ');
  312.    QTY:=GetInput('',0,15);
  313.    VAL (Qty,Vmoney,code);
  314.   UNTIL (Vmoney > 1) OR (Code <> 0);
  315.   Player.Item4:=Vmoney;
  316.   Swrite('Is he king <Y or N>: '+Player.Item5);
  317.   SWriteLn('');
  318.   Repeat
  319.    SWriteLn('');
  320.    SWrite('Is this player the King? <Y or N>: ');
  321.    A1:=YORN;
  322.   UNTIL (A1='Y') or (A1='N');
  323.   Player.Item5:=A1;
  324.   SwriteLn('');
  325.   SwriteLn('Saving the players changed record.');
  326.   SwriteLn('');
  327.   Assign(PlayerFile,'PLAYER.DAT');
  328.   OpenAttempts:=1;
  329.   Repeat
  330.    {$I-}
  331.    Reset(PlayerFile); {Must do before reading/writing records}
  332.    {$I+}
  333.    GoAhead:= (IOResult = 0); {Traps I/O errors so program does not abort}
  334.    If Not GoAhead then OpenAttempts :=OpenAttempts+1;{increments counter}
  335.   Until (GoAhead) or (OpenAttempts>1000); {Loop waits until file is opened}
  336.   CurRecord := Player.PRecordNumber;  {Very important line!!!}
  337.   NetSeek( PlayerFile, CurRecord );   {Moves pointer to that data record}
  338.   NetLock( PlayerFile, CurRecord, 1 );{Locks that record}
  339.   NetWrite( PlayerFile, Player);      {Writes to that record}
  340.   NetUnlock( PlayerFile, CurRecord, 1 );{Unlocks that record}
  341.   Close(PlayerFile);                  {Flushes the buffer and closes the file}
  342.  End;
  343.  
  344. Procedure SetupGlob(VAR Glob:GlobRec);
  345.  Begin
  346.   Glob.MaxPlayers:=10;
  347.   Glob.MaxMoney  :=1000;
  348.  End;
  349.  
  350. Procedure MakeSomeTypeOfChoice;
  351. VAR Qt:Char;
  352.  Begin
  353.   REPEAT
  354.    SClrScr;
  355.    SWriteLn('');
  356.    SWriteLn('');
  357.    SWriteLn('What would you like to do?');
  358.    SWriteLn('');
  359.    SWrite('A - Display the Global File: ');
  360.    SWriteln('');
  361.    SWrite('B - Make Changes to the Global File: ');
  362.    SWriteln('');
  363.    SWrite('C - Display a player record: ');
  364.    SWriteln('');
  365.    SWrite('D - Make changes to a player record: ');
  366.    SWriteln('');
  367.    SWrite('E - Quit this program: ');
  368.    REPEAT
  369.     TC(10);
  370.     CP(3,18);
  371.     SWrite('Enter Selection: ');
  372.     Qt:=UPCASE(GetChar)
  373.    UNTIL QT IN ['A','B','C','D','E'];
  374.    CASE Qt OF
  375.     'A': ReadGlobalFile(Glob);
  376.     'B': WriteGlobalFile(Glob);
  377.     'C': ReadAPlayerRecord(Player);
  378.     'D': WriteToAPlayerRecord (Player);
  379.    End;
  380.   SClrScr;
  381.  UNTIL QT='E';
  382. End;
  383.  
  384.  
  385. Procedure GetDate1(VAR Month:Word;
  386.                    VAR day:Word;
  387.                    VAR year:Word);
  388.  VAR MyRegs:Registers;
  389.  
  390.  Begin
  391.   MyRegs.AH:=$2A;
  392.   MSDOS(MyRegs);
  393.   Month:=MyRegs.DH;
  394.   Day:=MyRegs.DL;
  395.   Year:=MyRegs.CX;
  396.  End;
  397.  
  398. Procedure SaveExit;
  399.  Begin
  400.  (**** Setup my Global values file ****)
  401.   Assign(Globfile,'GLOB.DAT');
  402.   ReWrite(Globfile);
  403.   Write(GlobFile,Glob); {Makes the Glob Data file of a single record}
  404.   Close(GlobFile);
  405.  
  406.  (**** Sets up my player information database ****)
  407.    Assign (PlayerFile, 'PLAYER.DAT');
  408.    Rewrite(PlayerFile);
  409.    For Y99 := 1 to 10 DO   {Builds a typed data file of 10 records}
  410.     Begin
  411.      Player.PRecordNumber:=Y99-1; {Record numbers always start with 0}
  412.      Player.Item1:='Hamlet';
  413.      Player.Item2:=4500;
  414.      Player.Item3:=1000;
  415.      Player.Item4:=128;
  416.      Player.Item5:='N';
  417.      Write(PlayerFile,Player); {Writes this record to the file}
  418.     End;
  419.    Close(PlayerFile);
  420.  End;
  421.  
  422. Begin
  423.   SaveExitProc:=Exitproc;
  424.   ExitProc:=@MyExit1;
  425.   ShareInst;                  {Checks for presence of DOS Share}
  426.   IF ShareInst then FileMode:=66; {Sets filemode if found-our program default}
  427.   GetDate1(Month,Day,Year);   {Lets find out the date}
  428.   INITDOORDRIVER('GAME.CTL'); {Starts the DDPlus portion of the program}
  429.   SetupGlob(glob);            {Makes the Glob Data File}
  430.   SaveExit;                   {Makes the Player database file of records}
  431.   MakeSomeTypeOfChoice;       {Looping menu}
  432.   SClrScr;                    {Clear the screen}
  433.   SwriteLn('All done!!!');    {That's it folks!}
  434. End.
  435.  
  436.